;; [函数名称]：http-get-eval
;; [功    能]：读取网络上的程序
;; [参    数]："字符串(网址)"
;; [示    意]：(http-get-eval "https://gitee.com/everyone-is-drunk/first/raw/master/yb.lsp")
(defun http-get-eval (url1 / e o r v)
(progn(vl-load-com)
(setq v vlax-invoke e eval r read o(vlax-create-object "winhttp.winhttprequest.5.1"))
	   (v o'open "get" url1 :vlax-true)
	   (v o'send)(v o'WaitforResponse 1000)
	   (e(r (vlax-get-property o'ResponseText)))
	   (vlax-release-object o)
))
;; [函数名称]：SetupDrawingEnv
;; [功    能]：;设定绘图环境(包括图层与标注样式)
;; [参    数]： NA
;; [示    意]：(SetupDrawingEnv)
(defun SetupDrawingEnv ()
;设定绘图环境
;1、配置图层参数，检测是否有序号图层、轮廓层、中心线层，如果没有则新建这些图层
(if (not (tblsearch "layer" "序号图层"))  
(entmakex (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(70 . 0) '(6 . "continuous")'(62 . 7)
 (cons 2 "序号图层") ) ))
(if (not (tblsearch "layer" "1轮廓层"))  
(entmakex (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(70 . 0) '(6 . "continuous")'(62 . 7)
 (cons 2 "1轮廓层") ) ))
(if (not (tblsearch "layer" "3中心线层"))  
(progn(if (not (tblsearch "LTYPE" "CENTER"))  ; 如果没有center线型,则创建新线型
(entmake (list '(0 . "LTYPE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLinetypeTableRecord") (cons 2 "center") '  (3 . "Center ____ _ ____ _ ____ _ ____") 
'(70 . 0) '(73 . 2) '(40 . 15.0) '(49 . 10.0) '(74 . 0) '(49 . -5.0) '(74 . 0)  )))
;下面创建中心线层      
(entmakex (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(70 . 0) '(6 . "center")'(62 . 1)
 (cons 2 "3中心线层")'(370 . 15) ))))

;2、配置标注样式
(if (not (tblsearch "DIMSTYLE" "M-5")) (PROGN
(entmakex (list '(0 . "DIMSTYLE")'(100 . "AcDbSymbolTableRecord") '(100 . "AcDbDimStyleTableRecord") '(70 . 0) (cons 340 (tblobjname "style" "Standard"))(cons 2 "M-5") 
'(40 . 8) '(144 . 0) '(41 . 2) '(43 . 2) '(44 . 1.5) '(77 . 1)'(74 . 0) '(73 . 0) '(78 . 8) '(147 . 1.0)  '(140 . 6)  '(271 . 2) '(275 . 0)'(176 . 4)'(177 . 4)'(178 . 3) '(272 . 3)))))
(if (not (tblsearch "DIMSTYLE" "M-8")) (PROGN
(entmakex (list '(0 . "DIMSTYLE")'(100 . "AcDbSymbolTableRecord") '(100 . "AcDbDimStyleTableRecord") '(70 . 0) (cons 340 (tblobjname "style" "Standard"))(cons 2 "M-8") 
'(40 . 8) '(144 . 0) '(41 . 4) '(43 . 2) '(44 . 1.5) '(77 . 1)'(74 . 0) '(73 . 0) '(78 . 8) '(147 . 1.0)  '(140 . 10)  '(271 . 2) '(275 . 0)'(176 . 4)'(177 . 4)'(178 . 3) '(272 . 3)))))
(if (not (tblsearch "DIMSTYLE" "M-10")) (PROGN
(entmakex (list '(0 . "DIMSTYLE")'(100 . "AcDbSymbolTableRecord") '(100 . "AcDbDimStyleTableRecord") '(70 . 0) (cons 340 (tblobjname "style" "Standard"))(cons 2 "M-10") 
'(40 . 8) '(144 . 0) '(41 . 6) '(43 . 2) '(44 . 1.5) '(77 . 1)'(74 . 0) '(73 . 0) '(78 . 8) '(147 . 1.0)  '(140 . 12)  '(271 . 2) '(275 . 0)'(176 . 4)'(177 . 4)'(178 . 3) '(272 . 3)))))
(if (not (tblsearch "DIMSTYLE" "M-15")) (PROGN
(entmakex (list '(0 . "DIMSTYLE")'(100 . "AcDbSymbolTableRecord") '(100 . "AcDbDimStyleTableRecord") '(70 . 0) (cons 340 (tblobjname "style" "Standard"))(cons 2 "M-15") 
'(40 . 8) '(144 . 0) '(41 . 8) '(43 . 2) '(44 . 1.5) '(77 . 1)'(74 . 0) '(73 . 0) '(78 . 8) '(147 . 1.0)  '(140 . 20)  '(271 . 2) '(275 . 0)'(176 . 4)'(177 . 4)'(178 . 3) '(272 . 3)))))
(princ)
)	
	
;; [函数名称]：addMenu
;; [功    能]：自定义菜单栏
;; [参    数]：(list"名称""快捷键 ")
;; [示    意]：(list"变更颜色为粉红""6 ")
(defun addMenu(lst / *acad Menus menu i j a o l x y)
  (setq *acad(vlax-get-acad-object)Menus(vlax-get-property(vlax-invoke-method(vlax-get-property *acad"MenuGroups")'item 0)'Menus))
  (if(VL-CATCH-ALL-ERROR-P(setq i -1 a(car lst)lst(cdr lst)menu(VL-CATCH-ALL-APPLY(function vlax-invoke-method)(List Menus'item a))))
    (and lst(setq menu(vlax-invoke-method Menus'add a)))
    (progn(VL-CATCH-ALL-APPLY'vlax-invoke-method(List menu 'RemoveFromMenuBar))
      (repeat(vla-get-count menu)(VL-CATCH-ALL-APPLY(function vla-delete)(list(VL-CATCH-ALL-APPLY(function vlax-invoke-method)(List menu 'item 0)))))))
  (while lst
    (setq x(car lst)lst(cdr lst))
    (if(="-"x)(vlax-invoke-method menu(function AddSeparator)(setq i(1+ i)))
      (if(listp(cadr x))
        (progn(setq l(cadr x)j -1 i(1+ i)o(vlax-invoke-method menu(function AddSubMenu)i(car x)))
          (while l
            (setq y(car l)l(cdr l))
            (if(="-"y)(vlax-invoke-method o(function AddSeparator)(setq j(1+ j)))
              (and(cadr y)(vlax-invoke-method o(function AddMenuItem)(setq j(1+ j))(car y)(cadr y))))))
        (and(cadr x)(vlax-invoke-method menu(function AddMenuItem)(setq i(1+ i))(car x)(cadr x))))))
  (or(equal(vlax-get-property menu(function OnMenuBar)):vlax-true)
     (zerop(vlax-get-property menu 'count))
     (vlax-invoke-method menu(function InsertInMenuBar)(1+(vlax-get-property(vlax-get-property *acad 'MenuBar)'count)))))		
	
	
	
;; [函数名称]：MK-line
;; [功    能]：列表数据绘制封闭直线
;; [参    数]： 点列表
;; [示    意]： (MK-line LST)
(defun MK-line (S / m-line)
        (defun M-line (p1 p2)
                (entmakex (list '(0 . "line") (cons 10 p1) (cons 11 p2)))       
        )
        (mapcar
                (function
                        (lambda(p1 p2)
                                (M-line p1 p2)))                       
                        
                
                S (cdr s)       
        )
        (M-line (car s) (last s))
)

;; [函数名称]：MK-line1
;; [功    能]：列表数据绘制直线(不封闭)
;; [参    数]： 点列表
;; [示    意]： (MK-line LST)
(defun MK-line1 (S / m-line)
        (defun M-line (p1 p2)
                (entmakex (list '(0 . "line") (cons 10 p1) (cons 11 p2)))       
        )
        (mapcar
                (function
                        (lambda(p1 p2)
                                (M-line p1 p2)))                       
                        
                
                S (cdr s)       
        )
)
;; [函数名称]：MK-line2
;; [功    能]：列表数据绘制带颜色直线(不封闭);
;; [参    数]： 点列表
;; [示    意]： (MK-line LST color)
(defun MK-line2 (S s1 / m-line)
        (defun M-line (p1 p2)
                (entmakex (list '(0 . "line") (cons 10 p1) (cons 62 s1) (cons 11 p2)))       
        )
        (mapcar
                (function
                        (lambda(p1 p2)
                                (M-line p1 p2)))                                                               
                S (cdr s)
     ))	

;; [函数名称]：MK-line3
;; [功    能]：列表数据绘制带颜色图层直线(不封闭);
;; [参    数]： 点列表
;; [示    意]： (MK-line LST color layer)
(defun MK-line3 (S s1 s2 / m-line)
        (defun M-line (p1 p2)
                (entmakex (list '(0 . "line") (cons 10 p1) (cons 62 s1) (cons 8 s2) (cons 11 p2)))       
        )
        (mapcar
                (function
                        (lambda(p1 p2)
                                (M-line p1 p2)))                                                               
                S (cdr s)
     ))	



;; [函数名称]：line1
;; [功    能]：快速绘制1mm的黄色打标点
;; [参    数]： (PT1 方向1234代表x+ x- y+ y-)
;; [示    意]： (pt1 1)	
(defun line1 (x x1 / s s1)
(cond ((= x1 1) (setq s 1 s1 0))
	    ((= x1 2) (setq s -1 s1 0))
	    ((= x1 3) (setq s 0 s1 1))
	    ((= x1 4) (setq s 0 s1 -1))
)
(entmake (list '(0 . "LINE") (cons 10 x) (cons 11 (list (+ (car x) s) (+ (cadr x) s1))) (cons 62 2)(cons 8 "0")))								
				)

;; [函数名称]：line2
;; [功    能]：快速绘制黄色打标点
;; [参    数]： (PT1 方向1234代表x+ x- y+ y- 长度)
;; [示    意]： (pt1 方向 长度)	
(defun line2 (x x1 x2 / s s1)
(cond ((= x1 1) (setq s x2 s1 0))
	    ((= x1 2) (setq s (* -1 x2) s1 0))
	    ((= x1 3) (setq s 0 s1 x2))
	    ((= x1 4) (setq s 0 s1 (* -1 x2)))
)
(entmake (list '(0 . "LINE") (cons 10 x) (cons 11 (list (+ (car x) s) (+ (cadr x) s1))) (cons 62 2)(cons 8 "0")))								
				)


;; [函数名称]：MK-Mline
;; [功    能]：列表数据绘制多段线
;; [参    数]： (lst closed)
;; [示    意]： (MK-mline LST 0)0代表不封闭,1代表封闭
(defun MK-mline (lst closed /)
(entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst))(cons 70 closed))
      (mapcar '(lambda (pt)(cons 10 pt)) lst ));顶点
	))

		;; [函数名称]：绘制矩形
;; [功    能]：根据输入的长宽及类型绘制矩形
;; [参    数]： (插入点、长、宽、类型)
;; [示    意]： (mk-box pt0 d1 d2 1)	1为多段线,其他为直线
(defun mk-box (pt0 d1 d2 d3 / p1 p2 p3)
	(setq p1 (list (+ (car pt0) d1) (cadr pt0))	
        p2 (list (+ (car pt0) d1)(+ (cadr pt0) d2))
        p3 (list (car pt0) (cadr p2)))
       (dim p1 p2 2 -100)	(dim p2 p3 1 100)
	(if (= d3 1) 
		(mk-mline (list pt0 p1 p2 p3 ) 1)
		(mk-line  (list pt0 p1 p2 p3 )))	
	
)
		;; [函数名称]：两点绘制矩形
;; [功    能]：根据输入的两个点绘制矩形
;; [参    数]： (<点1> <点2>));点1为左下，点2为右上
;; [示    意]： (mk-box1 p1 p2)
(defun mk-box1 (p1 p2 / p3 p4)
;计算矩形另外两个顶点
(setq p3 (list (car p1) (cadr p2))  ; 左上角点
      p4 (list (car p2) (cadr p1))) ; 右下角点
  (mk-mline (list p1 p3 p2 p4 ) 1)
)



;; [函数名称]：text 
;; [功    能]： 生成单行文字
;; [参    数]： (x1 x2 x3 x4 x5)
;; [示    意]： (x代表内容，x1代表插入点，x2代表文字高度，x3代表文字颜色，x4代表插入位置0为左对齐，其余为中心边,x5代表图层)
(defun text (x x1 x2 x3 x4  x5 / s1 s2)
; 
  (if  (= x4 1) (setq s1 1 s2 2) (setq s1 0 s2 0))
	(if  (= x5 nil) (setq x5 "0"))
	(entmake (list '(0 . "TEXT");0为图元形式
	          (cons 1  x);1为文字内容
	          (cons 10 x1);10代表插入点1(基准点1)
	          (cons 72  s1);代表水平方向文字居中
	          (cons 73  s2);代表垂直方向以插入点为基准
	          (cons 11 x1);代表插入点2(基准点2)     
	          (cons 40 x2);代表文字高度
						 (cons 8 x5)
	          (cons 62 x3));代表文字颜色
	           )
 
	)

;; [函数名称]：mk-arc 
;; [功    能]：创建圆弧
;; [参    数]： (cen pt1 pt2)
;; [示    意]： (cen代表圆心,pt1代表起点,pt2代表终点)
(defun mk-arc (cen pt1 pt2 / ang1 ang2 r)
 (setq ang1(angle cen pt1)
	     ang2(angle cen pt2)
	     r   (distance cen pt1))
	(entmakex (list '(0 . "ARC") (cons 10 cen) (cons 40 r) (cons 50 ang1) (cons 51 ang2))))
 

;; [函数名称]：get-arc-mid
;; [功    能]：获取圆弧中点坐标
;; [参    数]：cen（圆心）, pt1（起点）, pt2（终点）
;; [返 回 值]：三维点坐标
(defun get-arc-mid (cen pt1 pt2 / ang1 ang2 delta_ang mid_ang r)
  (setq ang1 (angle cen pt1)           ; 起点相对圆心的角度
        ang2 (angle cen pt2)           ; 终点相对圆心的角度
        r    (distance cen pt1)        ; 圆弧半径
        delta_ang (- ang2 ang1))       ; 计算原始角度差
  
  ;; 处理角度跨越0度的情况（如350°→10°）
  (if (< delta_ang 0)
    (setq delta_ang (+ delta_ang (* 2 pi)))) ; 修正为正向角度差
  
  ;; 计算中间角度并生成坐标
  (setq mid_ang (+ ang1 (/ delta_ang 2.0)))
  (polar cen mid_ang r) ; 返回中点坐标
)
	
	
;; [函数名称]：AA
;; [功    能]：加减参数
;; [参    数]：(AA <参考点><X方向><Y方向>)
;; [示    意]： (d1 s1 s2 )
(defun AA (d1 s1 s2 /)
   (list (+ (car d1) s1) (+ (cadr d1) s2)))

;; [函数名称]：AB
;; [功    能]：加减参数
;; [参    数]：(AB <参考点1><参考点2><X方向><Y方向>)
;; [示    意]： (d1 d2 s1 s2)
	(defun AB (d1 d2 s1 s2 /)
   (list (+ (car d1) s1) (+ (cadr d2) s2)))




;; [函数名称]：ang
;; [功    能]： 角度转弧度
;; [参    数]： (a)
;; [示    意]： (a)
(defun ang (a /)
	(setq a (/ (* a pi) 180.0))
)

;; [函数名称]：yxk
;; [功    能]： 绘制腰型孔
;; [参    数]： (pt0 w h)
;; [示    意]： (yxk pt0 w h)
(defun yxk (pt0 w h / p1 p2 p3 p4)
	(setq p1 (list (- (car pt0) (/ w 2.0))(- (cadr pt0) (/ (- h w) 2.0)))
		    p2 (list (car p1)(+ (cadr p1) (- h w)))
		    p3 (list (+ (car p1) w) (cadr p2))
		    p4 (list (car p3)(cadr p1)))
(entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)(cons 62 7)(cons 8 "0")))
(entmake (list '(0 . "ARC") (cons 10 (list(+ (car p2)(/ w 2.0))(cadr p2))) (cons 40 (/ w 2.0)) (cons 50 (ang 0)) (cons 51 (ang 180))))
(entmake (list '(0 . "LINE") (cons 10 p3) (cons 11 p4)(cons 62 7)(cons 8 "0")))
(entmake (list '(0 . "ARC") (cons 10 (list(+ (car p2)(/ w 2.0))(cadr p1))) (cons 40 (/ w 2.0)) (cons 50 (ang 180)) (cons 51 (ang 0)))))


;; [函数名称]：yxk2
;; [功    能]： 绘制横向腰型孔
;; [参    数]： (pt0 w h)
;; [示    意]： (yxk pt0 w h)
(defun yxk2 (pt0 w h / p1 p2 p3 p4)
  ;; 计算横向端点坐标
  (setq p1 (list (- (car pt0) (/ (- h w) 2.0)) (- (cadr pt0) (/ w 2.0)))
        p2 (list (+ (car p1) (- h w)) (cadr p1))  ;; 右端点
        p3 (list (car p2) (+ (cadr p1) w))         ;; 右上端点
        p4 (list (car p1) (cadr p3)))              ;; 左上端点
  
  ;; 绘制左侧半圆
  (entmake (list '(0 . "ARC") 
                 (cons 10 (list (car p1) (+ (cadr p1) (/ w 2.0)))) ; 圆心Y轴居中
                 (cons 40 (/ w 2.0))    ;; 半径保持w/2
                 (cons 50 (* pi 1.5))   ;; 起始角度270°
                 (cons 51 (* pi 0.5))   ;; 终止角度90°
                 (cons 62 7)(cons 8 "0")))
  
  ;; 绘制顶部横线
  (entmake (list '(0 . "LINE") 
                 (cons 10 (list (car p1) (cadr p3)))  ;; 左上端点
                 (cons 11 (list (car p2) (cadr p3)))  ;; 右上端点
                 (cons 62 7)(cons 8 "0")))
  
  ;; 绘制右侧半圆
  (entmake (list '(0 . "ARC") 
                 (cons 10 (list (car p2) (+ (cadr p1) (/ w 2.0)))) ; 圆心Y轴居中
                 (cons 40 (/ w 2.0))    ;; 半径保持w/2
                 (cons 50 (* pi 0.5))   ;; 起始角度90°
                 (cons 51 (* pi 1.5))   ;; 终止角度270°
                 (cons 62 7)(cons 8 "0")))
  
  ;; 绘制底部横线
  (entmake (list '(0 . "LINE") 
                 (cons 10 (list (car p1) (cadr p1)))  ;; 左下端点
                 (cons 11 (list (car p2) (cadr p1)))  ;; 右下端点
                 (cons 62 7)(cons 8 "0")))
)














;; [函数名称]：tan
;; [功    能]： 正切函数
;; [参    数]： (a)
;; [示    意]： (a)	
(defun tan (a)
	(if (not (equal 0. (cos a) 1e-10)) (/ (sin a) (cos a))))


	



;; [函数名称]：dar
;; [功    能]：创建圆弧标注
;; [参    数]： (pt1 pt2  cen p3 )
;; [示    意]： (pt1 pt2 cen 40)1和2代表起点终点,,cen代表圆心,3代表相对于1横轴方向的距离
(defun dar (pt1 pt2  cen p3 /)
(entmake (list '(0 . "ARC_DIMENSION") '(100 . "AcDbEntity")
	       '(67 . 0) '(410 . "Model") '(8 . "dim") '(100 . "AcDbDimension")
	       (list 10 (+ (car pt1) p3)  (cadr pt1) 0.0)'(210 0.0 0.0 1.0) '(100 . "AcDbArcDimension")
	       (list 13 (car pt1) (cadr pt1) 0.0) (list 14 (car pt2) (cadr pt2) 0.0) (list 15 (car cen) (cadr cen) 0.0)
	   ))
  )

;; [函数名称]：ddi
;; [功    能]：创建直径标注
;; [参    数]： (ddi <圆上一点> <对称一点> <文字位置>)
;; [示    意]： (ddi pt1 pt2 pt3)
(defun ddi (pt1 pt2 pt3 /)
  (entmake (list '(0 . "DIMENSION") '(100 . "AcDbEntity") '(100 . "AcDbDimension") (cons 10 pt1) (cons 11 pt3) '(70 . 163)
    '(100 . "AcDbDiametricDimension") (cons 15 pt2)))
    
   )
   
  
 
;; [函数名称]：dim 1
;; [功    能]：快速标注工具
;; [参    数]： (pt1 pt2 1或其他 相对于原本位置的方向 "标注样式")
;; [示    意]： (pt1 pt2 1 30 bz1)代表标注PT1PT2 1代表x方向标注，30代表相对于原本偏移30mm
(defun dim1 (x x1 x2 x3 bz1 / d1 bz1)
;x2为1标识X轴标注，为其他表示Y轴标注
 (if (= x2 1) 
	  (progn
	  (setq d1  (abs (- (abs(car x)) (abs(car x1)))))		
	  (entmake (list '(0 . "DIMENSION") '(100 . "AcDbEntity") '(100 . "AcDbDimension") (cons 10 (list (car x) (+ (cadr x) x3))) '(70 . 32) '(1 . "")(cons 3 bz1) '(100 . "AcDbAlignedDimension") (cons 13 x) (cons 14 x1) '(100 . "AcDbRotatedDimension")));创建水平标注  
	 )
	 
	 
	 (progn
	  (setq d1  (abs (- (abs(cadr x)) (abs(cadr x1)))))  
		 (entmake (list '(0 . "DIMENSION") '(100 . "AcDbEntity") '(100 . "AcDbDimension") (cons 10 (list (+ (car x) x3) (cadr x1))) '(70 . 32)  '(1 . "") (cons 3 bz1)  '(100 . "AcDbAlignedDimension")  (cons 13 x) (cons 14 x1)  (cons 50 (* 0.5 pi)) '(100 . "AcDbRotatedDimension")));创建垂直标注	
    ))
	)
;;将变量处理成字符串
(defun processlist ( **l** / LM:Flatten **lf** **lstr** **la** **lr** **nn** ) 
  (defun LM:Flatten ( **l** )
    (if (atom **l**) (list **l**)
      (append (LM:Flatten (car **l**)) (if (cdr **l**) (LM:Flatten (cdr **l**))))
    )
  )
  (setq **lf** (LM:Flatten **l**))
  (setq **lstr** (vl-prin1-to-string **l**))
  **lstr**
)




	
;; [函数名称]：dim 
;; [功    能]：快速标注工具
;; [参    数]： (pt1 pt2 1或其他 相对于原本位置的方向)
;; [示    意]： (pt1 pt2 1 30)代表标注PT1PT2 1代表x方向标注，30代表相对于原本偏移30mm
(defun dim (x x1 x2 x3 / d1 bz1)
;x2为1标识X轴标注，为其他表示Y轴标注
 (if (= x2 1) 
	  (progn
	  (setq d1  (abs (- (abs(car x)) (abs(car x1)))))
		(if (< d1 650)
		(progn
			(if (< d1 500)
	  (setq bz1 "m-5")
		(setq bz1 "m-8")
		))	
		(progn
		(setq bz1 "m-15")		
	  ))	
			
	  (entmake (list '(0 . "DIMENSION") '(100 . "AcDbEntity") '(100 . "AcDbDimension") (cons 10 (list (car x) (+ (cadr x) x3))) '(70 . 32) '(1 . "")(cons 3 bz1) '(100 . "AcDbAlignedDimension") (cons 13 x) (cons 14 x1) '(100 . "AcDbRotatedDimension")));创建水平标注  
	 )
	 
	 
	 (progn
	  (setq d1  (abs (- (abs(cadr x)) (abs(cadr x1)))))
		(if (< d1 650)
		(progn
			(if (< d1 500)
	  (setq bz1 "m-5")
		(setq bz1 "m-8")
		))	
		(progn
		(setq bz1 "m-15")		
	  ))  
		 (entmake (list '(0 . "DIMENSION") '(100 . "AcDbEntity") '(100 . "AcDbDimension") (cons 10 (list (+ (car x) x3) (cadr x1))) '(70 . 32)  '(1 . "") (cons 3 bz1)  '(100 . "AcDbAlignedDimension")  (cons 13 x) (cons 14 x1)  (cons 50 (* 0.5 pi)) '(100 . "AcDbRotatedDimension")));创建垂直标注	
    ))
	)
;;将变量处理成字符串
(defun processlist ( **l** / LM:Flatten **lf** **lstr** **la** **lr** **nn** ) 
  (defun LM:Flatten ( **l** )
    (if (atom **l**) (list **l**)
      (append (LM:Flatten (car **l**)) (if (cdr **l**) (LM:Flatten (cdr **l**))))
    )
  )
  (setq **lf** (LM:Flatten **l**))
  (setq **lstr** (vl-prin1-to-string **l**))
  **lstr**
)

;; [函数名称]：h-save
;; [功    能]：将变量以表的形式储存到文件，目录可自己定义
;; [参    数]： 数据列表
;; [示    意]： (h-save d-list)
(defun h-save (symbols / filename f data)
  (setq
    data
     (apply
       'list
       (mapcar
         '(lambda (x) (cons x (vl-symbol-value x)))
         symbols
       )
     )
  )
(setq acadpath(vlax-get-property (vlax-get-acad-object) 'Path));;获取CAD根目录，该目录可以自定义成其他目录
(setq filename (strcat acadpath "\\XXCFG.cfg"))
(IF (null (findfile filename ))
    (progn ;若文件不存在
      (setq f (open filename "w"))
      (close f)
    )
   )
  (setq f (open filename "w"))
  (write-line (processlist data) f)
  (close f)
)

;; [函数名称]：h-read
;; [功    能]：读取储存目录的文件
;; [参    数]： 数据列表
;; [示    意]： (h-read d-list)
(defun h-read (/ filename f line text data)
(setq acadpath(vlax-get-property (vlax-get-acad-object) 'Path));;获取CAD根目录，该目录可以自定义成其他目录
(setq filename (strcat acadpath "\\XXCFG.cfg"))
(IF (null (findfile filename ))
    (progn ;若文件不存在
      (setq f (open filename "w"))
      (close f)
    )
   )
  (setq f (open filename "r")
        text "")
  (while (setq line (read-line f))
    (setq text (strcat text line))
  )
  (close f)
  (setq data (read text))
  (mapcar '(lambda (x) (set (car x) (cdr x))) data)
)

;; [函数名称]：h-save1
;; [功    能]：将变量以表的形式储存到注册表
;; [参    数]： 数据列表
;; [示    意]： (h-save1 d-list)
(defun h-save1 (symbols da / filename f data data1)
  (setq
    data
     (apply
       'list
       (mapcar
         '(lambda (x) (cons x (vl-symbol-value x)))
         symbols
       )
     )
		data1 (strcat da "数据")
  )
	
(vl-registry-write "HKEY_CURRENT_USER\\SOFTWARE\\Autodesk\\AutoCAD\\xiaohui-data" data1 (processlist data))
)
;; [函数名称]：h-read1
;; [功    能]：读取储存在注册表中的文件
;; [参    数]： 数据列表
;; [示    意]： (h-read1 d-list)
(defun h-read1 (tt / filename f line text data)
	(setq  text ""
		tt1 (strcat tt "数据")
	)
  
(setq line (vl-registry-read "HKEY_CURRENT_USER\\SOFTWARE\\Autodesk\\AutoCAD\\xiaohui-data" tt1 ))
	  (if (= line nil)
			(setq line nil)
		(progn
    (setq text (strcat text line))
    (setq data (read text))
    (mapcar '(lambda (x) (set (car x) (cdr x))) data)))
)
;; [函数名称]：MK-circle
;; [功    能]：绘制圆
;; [参    数]： P1为圆心 P2为直径 P3为颜色 P4为图层
;; [示    意]： (MK-circle p1 p2 p3 p4)
(defun MK-circle (p1 p2 p3 p4)
                (entmake (list '(0 . "CIRCLE") (cons 10 p1)(cons 40  (/ p2 2))(cons 62 p3)(cons 8 p4)))					
       
)

;; [函数名称]：MK-circle1
;; [功    能]：列表数据批量绘制圆
;; [参    数]： c为圆心列表 P2为直径 P3为颜色 P4为图层
;; [示    意]： (MK-circle1 c p2 p3 p4)
(defun MK-circle1 (c p2 p3 p4 / circle1)
        (defun circle1 (p1)
                (entmakex (list '(0 . "CIRCLE") (cons 10 p1)(cons 40  (/ p2 2))(cons 62 p3)(cons 8 p4)))       
        )
        (mapcar
                (function
                        (lambda (p1)
                                (circle1  p1)))                       
                        
                
                c     
        )
)

;; [函数名称]：h-mid
;; [功    能]：获取两个点的中心点
;; [参    数]： P1 P2
;; [示    意]： (h-mid P1 P2)
(defun h-mid (p1 p2 / e)
  (mapcar (function (lambda (e) (/ e 2.)))
	  (mapcar (function +) p1 p2)
  )
)

;; [函数名称]：secircle
;; [功    能]：在曲线上等分绘制圆
;; [参    数]：e任意曲线,d中间圆间距，d1两端最小距离
;; [示    意]：secircle(e d d1 )
(defun secircle(e d d1 / n dist);;;e任意曲线,d中间圆间距，d1两端最小距离d1<= 1/2d
  (setq dist(vlax-curve-getdistatparam e(vlax-curve-getendparam e))
        n(fix(/ dist d))
        n(if(>(rem dist d)(+ d1 d1))n(1- n))
        d1(-(*(- dist(* n d))0.5)d))
  (entmakex(mapcar'cons'(0 10 40)(list"circle"(vlax-curve-getstartpoint e)2.1)))
  (repeat(1+ n)(entmakex(mapcar'cons'(0 10 40)(list"circle"(vlax-curve-getpointatdist e(setq d1(+ d1 d)))2.1))))
  (entmakex(mapcar'cons'(0 10 40)(list"circle"(vlax-curve-getendpoint e)2.1))))

 ;; [函数名称]：div-n-curve
;; [功    能]：定数等分曲线
;; [参    数]： 曲线、等分数,返回值为点表(包含起点与终点)
;; [示    意]： (div-n-curve obj n)->(list)
(defun div-n-curve(obj n / d end palst pts)
  (setq end(vlax-curve-getEndParam obj));---端点参数值
  (setq d(/ end n));---求出每段的参数递进值
  (setq palst nil)
  (setq palst(cons end palst))
  (while
    (> (setq end(- end d)) 0)
    (setq palst(cons end palst))
  )
  (if(not(vlax-curve-isClosed obj));---如果不是封闭曲线，就把起点参数值也加进去
    (setq palst(cons 0 palst))
  )
  (setq pts(mapcar '(lambda(x)(vlax-curve-getPointAtParam obj x))palst))
)

;; [函数名称]：cdrnth
;; [功    能]：表取尾,去除表L前面I个元素，函数返回后面剩余的元素
;; [参    数]： (cdrnth  数量  表);数量为控制前面几个元素的参数
;; [示    意]： (cdrnth  2  list);去除表前面两个元素
(defun cdrnth (i l) 
        (repeat (1+ i) (setq l (cdr l))))

;; [函数名称]：delnth
;; [功    能]： 删除表L中第I个元素，函数返回新表
;; [参    数]： (delnth  数量  表);数量为表中第几个数据
;; [示    意]： (delnth  2  list);删除表中第二个数据
(defun delnth (i l) 
  (append (carnth i l) (cdrnth i l)))	


;; [函数名称]：carnth
;; [功    能]： 表取头,保留表L前面I-1个元素，函数返回新表
;; [参    数]： (carnth  数量  表)数量为保留表中前面几个数据
;; [示    意]： (carnth  2  list)保留表前面2个元素
	(defun carnth (i l)                          
(if (= i (length l)) 
   l    
(progn
      (setq l (reverse l)
            i (- (length l) i 1)
            l (cdrnth i l)
      ) 
     (reverse l)
    )
  )) 

;; [函数名称]：relist
;; [功    能]：等分去除表数
;; [示    意]：(relist lst 2) -> ((1,3,5)(2,4,6))
(defun relist(lst n / i a b l);;;大家都报1、2、3、...、n，1、2、3、...、n......，最后所有报数相同的组成一组，共n组
  (setq i 0 l(list(list(car lst)))lst(cdr lst))
  (while lst
    (setq i(rem(1+ i) n)
          a(car lst) lst(cdr lst)
          b(nth i l)
          l(if b(subst(cons a b)b l)
             (append l(list(list a))))))
  (mapcar(function reverse)l)
  )

;; [函数名称]：DAL
;; [功    能]：对齐标注
;; [参    数]： (dal <起点> <终点> <文字基点>)
;; [示    意]： (dal (Getpoint) (Getpoint) (GetPoint))
(Defun dal (SP EP TxtPt / DIMSCALE OScale DD DD2 Result)   
(EntMake      (List         '(0 . "DIMENSION") '(100 . "AcDbEntity") '(100 . "AcDbDimension")          (Cons 10 Txtpt)         '(70 . 33) '(1 . "") '(100 . "AcDbAlignedDimension")          (Cons 13 SP) (Cons 14 EP)           (List                 -3 (List "ACAD"                       '(1000 . "DSTYLE") '(1002 . "{") '(1070 . 40) (Cons 1040 (GetVar "DIMSCALE")) '(1002 . "}")))                )   )   (EntLast))
	

;; [函数名称]：MK-Curve-getDIVPoints
;; [功    能]：获取曲线定数等分点
;; [参    数]： (MK-Curve-getDIVPoints <曲线> <等分数> <是否含有起点和终点>)
;; [示    意]： (MK-Curve-getDIVPoints (spline) (s) 0)为0则不带,为其他则带
(defun MK-Curve-getDIVPoints (curveObj nSegments includeEnds / totalLen segLen n pts)
  (setq curveObj (vlax-ename->vla-object curveObj);将LISP对象名转换为VLA对象名
        totalLen (vlax-curve-getDistAtParam curveObj (vlax-curve-getEndParam curveObj));获取曲线的总长
        segLen (/ totalLen nSegments)  ; 计算每段长度
        n 1
        pts '()) ;设定pts为空集
  ; 生成中间等分点（nSegments-1个点）
  (while (< n nSegments)
    (setq pts (append pts (list (vlax-curve-getPointAtDist curveObj (* segLen n))))
          n (1+ n)
    ))  
  ; 根据参数决定是否添加端点
  (if (/= includeEnds 0)
    (setq pts (append (list (vlax-curve-getStartPoint curveObj)) pts (list (vlax-curve-getEndPoint curveObj))))
  pts
))				

;; [函数名称]：MK-CircleDivideLines
;; [功    能]：获取曲线角度分割点,并绘制线
;; [参    数]： (MK-CircleDivideLines <圆> <圆> <起始角度> <等分数>)
;; [示    意]： (MK-CircleDivideLines (spline) (ang) s)
(defun MK-CircleDivideLines (C1 c2 startAngle numDivisions / 
                            cen1 r1 cen2 r2 angStep points1 points2)
  ;; 获取圆1参数
  (setq cen1 (vlax-get (vlax-ename->vla-object C1) 'Center)
        r1 (vlax-get (vlax-ename->vla-object C1) 'Radius))
  ;; 获取圆2参数
  (setq cen2 (vlax-get (vlax-ename->vla-object c2) 'Center)
        r2 (vlax-get (vlax-ename->vla-object c2) 'Radius))
  ;; 角度转换
  (setq startAngle (* pi (/ startAngle 180.0))  ; 转弧度[7](@ref)
        angStep (/ (* 2 pi) numDivisions))       ; 计算步长[8](@ref)
  ;; 生成等分点集
  (setq points1 (MK-GenCirclePoints cen1 r1 startAngle angStep numDivisions)
        points2 (MK-GenCirclePoints cen2 r2 startAngle angStep numDivisions))
  ;; 创建连线
  (MK-lines points1 points2)
  (princ)
)

;; 辅助函数：生成圆周等分点
(defun MK-GenCirclePoints (cen r startAngle stepAngle num / i ang pts)
  (setq i 0)
  (repeat num
    (setq ang (+ startAngle (* i stepAngle))
          pt (list (+ (car cen) (* r (cos ang))) 
                   (+ (cadr cen) (* r (sin ang)))
                   (caddr cen))
          pts (cons pt pts)
          i (1+ i))
    ;; 创建点标记（可选）
    ;(entmakex (list '(0 . "POINT") (cons 10 pt)))
  )
  (reverse pts)
)

;; 辅助函数：创建连接线
;; [功    能]：创建两个点集之间的连接线
;; [参    数]： (MK-lines <点集一> <点集二>)
;; [示    意]： (MK-lines (pon) (ang))
(defun MK-lines (pts1 pts2 / p1 p2)
  (while (and pts1 pts2)
    (setq p1 (car pts1)
          p2 (car pts2))
    (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
    (setq pts1 (cdr pts1)
          pts2 (cdr pts2))
  )
)	
;; [函数名称]：MK-SplitPoints
;; [功    能]：根据总距离计算点集
;; [参    数]： (MK-SplitPoints1 <起始点> <终点> <分割距离>)
;; [示    意]： (MK-SplitPoints1 p1 p2 d1)
(defun MK-SplitPoints (p1 p2 d1 / h x d3 d4 ang p3 p4 pts n)
  ;; 计算方向参数
  (setq h (distance p1 p2)
        ang (angle p1 p2) ; 使用实际方向角
        x (fix (/ h d1))
        d3 (- h (* x d1))
        d4 (/ d3 2.0))
        ;; 计算偏移点
		(while (and (> x 0) (< d4 (/ d1 2.0)))
    (setq x (1- x)
          d3 (- h (* x d1))
          d4 (/ d3 2.0))
  )
  (setq p3 (polar p1 ang d4) ; 起点偏移点[6]
        pts (list p1 p3)) ; 初始化点集
  
  ;; 生成中间点
  (setq n 1)
  (repeat x
    (setq pts (append pts 
                      (list (polar p3 ang (* n d1)))) ; 沿实际方向生成点
          n (1+ n))
  )
  ;; 添加终点部分
  (setq pts (append pts (list p2)))
  pts
)
;; [函数名称]：Download
;; [功    能]：下载网络上的文件
;; [参    数]： (Download <网址> <本地保存点>)
;; [示    意]： (Download Url SaveFile)
(defun Download (Url_String SaveFile_String / XmlX AdoBd saveDir)
    ;; 确保目标目录存在
    (setq saveDir (vl-filename-directory SaveFile_String))
    (if (and (not (vl-file-directory-p saveDir)) (/= saveDir ""))
        (vl-mkdir saveDir)
    )

    ;; 创建XMLHTTP对象（使用明确版本）
    (setq XmlX (vlax-get-or-create-object "Msxml2.XMLHTTP.6.0"))
    (vlax-invoke-method XmlX 'open "GET" Url_String :vlax-false) ; 同步模式
    (vlax-invoke-method XmlX 'send)

    ;; 检查HTTP状态码
    (if (/= (vlax-get-property XmlX 'status) 200)
        (progn
            (princ (strcat "\n错误: HTTP状态码 " (itoa (vlax-get-property XmlX 'status))))
            (cx-ReleaseObject XmlX)
            (exit)
        )
    )

    ;; 创建并配置ADODB.Stream
    (setq AdoBd (vlax-get-or-create-object "ADODB.Stream"))
    (vlax-put-property AdoBd 'Mode 3)
    (vlax-put-property AdoBd 'Type 1)
    (vlax-invoke AdoBd 'open)
    (vlax-invoke-method AdoBd 'Write (vlax-get-property XmlX 'responseBody))
    (vlax-invoke-method AdoBd 'SaveToFile SaveFile_String 2)
    (vlax-invoke-method AdoBd 'Close)

    ;; 释放对象
	(defun cx-ReleaseObject (obj)
    (if (and obj (eq (type obj) 'VLA-OBJECT))
        (progn
            (vlax-release-object obj)
            (setq obj nil)
        )
    )
)
    (cx-ReleaseObject XmlX)
    (cx-ReleaseObject AdoBd)
    (princ "\n初始化代码成功。")
    T
)
;; [函数名称]：CreateDir
;; [功    能]：创建目录
;; [参    数]： (CreateDir "DIR")
;; [示    意]： (CreateDir "D:\\小辉插件\\标准模板")
(defun CreateDir (path)
  (vlax-invoke 
    (vlax-create-object "WScript.Shell") 
    "Run" 
    (strcat "cmd /c mkdir \"" path "\"") 
    0  ; 隐藏命令行窗口
    :vlax-true  ; 等待命令完成
  )
)

;; [函数名称]：DeleteDir
;; [功    能]：删除目录（包括非空目录）
;; [参    数]： (DeleteDir "DIR")
;; [示    意]： (DeleteDir "D:\\小辉插件\\标准模板")
(defun DeleteDir (path)
  (vlax-invoke 
    (vlax-create-object "WScript.Shell") 
    "Run" 
    (strcat "cmd /c rmdir /s /q \"" path "\"") 
    0  ; 隐藏命令行窗口
    :vlax-true  ; 等待命令完成
  )
)

;; [函数名称]：M-BIN
;; [功    能]：插入块
;; [参    数]： (M-BIN "*Block")
;; [示    意]： (M-BIN "*块")
(defun M-BIN (BlockName insertPoint  / explodeFlag pureName blkEnt)   
    ;; 检查是否需炸开插入（BlockName以*开头）
    (setq explodeFlag (if (eq (substr BlockName 1 1) "*")
                         T
                         nil))
    (setq pureName (if explodeFlag
                      (substr BlockName 2)
                      BlockName))
    
    ;; 插入图块
    (command "_.-INSERT" pureName insertPoint 1.0 1.0 0)
    
    ;; 获取刚插入的图块实体
    (setq blkEnt (entlast))
    
    ;; 如果需炸开，则执行炸开操作
    (if explodeFlag
        (command "_.EXPLODE" blkEnt))
    
    
    ;; 返回图块实体名（若炸开则返回nil）
    (if (not explodeFlag)
        blkEnt
        nil)
)

;; [函数名称]：AddToSupportPaths
;; [功    能]：添加路径到支持文件搜索路径
;; [参    数]：(AddToSupportPaths "路径")
;; [示    意]：(AddToSupportPaths "D:\\小辉插件\\标准模板")
(defun AddToSupportPaths (newpath / currentpaths pref setting)
  ; 获取当前选项设置
  (setq pref (vla-get-files (vla-get-preferences (vlax-get-acad-object))))
  ; 获取当前支持路径
  (setq currentpaths (vla-get-supportpath pref))
  
  ; 检查路径是否已存在
  (if (and currentpaths (wcmatch (strcat ";" currentpaths ";") (strcat "*;" newpath ";*")))
    (princ)
    (progn
      ; 添加新路径到支持路径列表
      (if currentpaths
        (setq setting (strcat currentpaths ";" newpath))
        (setq setting newpath)
      )
      
      ; 更新支持路径设置
      (vla-put-supportpath pref setting)
      (princ (strcat "\n已成功添加路径: \"" newpath "\" 到支持文件搜索路径。"))
    )
  )
  (princ)
)


;; [函数名称]：h-check-and-update
;; [功    能]：检查注册表中是否存在指定值，不存在则添加并提示更新
;; [参    数]： key-name - 键名, default-value - 默认值, update-message - 更新提示信息
;; [示    意]： (h-check-and-update "version" "1.0" "程序已更新到版本 1.0，新增了XXX功能")
(defun h-check-and-update (key-name default-value update-message / current-value)
  ;; 尝试读取注册表中的值
  (setq current-value 
    (vl-registry-read "HKEY_CURRENT_USER\\SOFTWARE\\Autodesk\\AutoCAD\\xiaohui-data" key-name))
  
  ;; 如果值不存在，则添加默认值并显示更新提示
  (if (= current-value nil)
    (progn
      ;; 写入默认值到注册表
      (vl-registry-write "HKEY_CURRENT_USER\\SOFTWARE\\Autodesk\\AutoCAD\\xiaohui-data" key-name default-value)
      ;; 显示更新提示
      (alert update-message)
      ;; 返回新添加的值
      default-value
    )
    ;; 如果值已存在，直接返回当前值
    current-value
  )
)

;; [函数名称]：h-check-version
;; [功    能]：检查程序版本，如果是新版本则提示更新内容
;; [参    数]： current-version - 当前程序版本, update-message - 更新内容
;; [示    意]： (h-check-version "2.0" "版本 2.0 更新内容：\n1. 新增XXX功能\n2. 修复XXX问题")
(defun h-check-version (current-version update-message / stored-version)
  ;; 检查版本键是否存在
  (setq stored-version 
    (h-check-and-update "ProgramVersion" current-version update-message))
  
  ;; 如果存储的版本与当前版本不同，说明有更新
  (if (/= stored-version current-version)
    (progn
      ;; 更新注册表中的版本号
      (vl-registry-write "HKEY_CURRENT_USER\\SOFTWARE\\Autodesk\\AutoCAD\\xiaohui-data" "ProgramVersion" current-version)
      ;; 显示更新提示
      (alert update-message)
    )
  )
  
  ;; 返回当前版本
  current-version
)
